perm filename TEXPRE.C[ERR,DEK] blob
sn#356218 filedate 1978-05-26 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00010 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 begin "TEXPRE" comment TEX preprocessing routines
C00004 00003 The following code is copied from TEXSYS
C00027 00004 Initializing the hash table and equivalents: identer,inithash
C00065 00005 Initializing the exception table
C00075 00006 Initializing the suffix table
C00082 00007 Initializing the prefix table
C00088 00008 Initializing the consonant-pair table
C00090 00009 Initializing the delimiter table
C00091 00010 The driver program
C00093 ENDMK
C⊗;
begin "TEXPRE" comment TEX preprocessing routines;
comment This program builds the tables that define TEX's built-in control
sequences and which contain TEX's built-in knowledge about hyphenation.
The relevant sections of TEXSYN and TEXSEM explain the format of these tables.
TEXPRE has been written as a separate module since it is unnecessary to have
all this lengthy initialization code present when running TEX, and since the
SAIL system has no mechanism for overlaying unneeded program segments.
The next page of code is simply copied from TEXSYS, then comes
new stuff and a new driver program instead of the TEXSYS main program;
require "TEXSYN.REL" load_module;
require "TEXSEM.REL" load_module;
require "TEXOUT.REL" load_module;
require "TEXEXT.REL" load_module;
require "TEXHDR.SAI" source_file;
comment The following code is copied from TEXSYS;
comment Error handling procedures: quit,error,backerror,overflow,confusion;
label end_of_texpre;
internal procedure quit # closes output files and terminates TEX;
begin DEBUGONLY bail # when debugging, here's a last chance to see the memory;
go to end_of_texpre;
end;
internal boolean pausing_on_errors # should TEX wait after error messages?;
internal boolean deletions_allowed # is it safe for error routine to call getnext?;
internal procedure error(string s) # prints an error message;
begin comment String s explains the type of error. This is displayed to the
user and then the current source code position is indicated;
print(nextline,"! ",s,".");
dumpcontext # prints indication of where the scanner is now;
if pausing_on_errors then while true do
begin integer c;
print("↑"); c←inchrw;
if c='15 then begin c←inchrw # ignore the line-feed; return end;
if c='12 then begin pausing_on_errors←false; return end;
if c="T" or c="t" then edfile(curfile,curfline,curfpage);
if c="X" or c="x" then quit;
DEBUGONLY if c="b" then begin bail; return end;
print(nextline,"Type <cr> to continue, <lf> to flash error messages,
t or T to edit, x or X to quit.");
end;
end;
internal procedure backerror(string s) # error followed by backinput;
begin error(s);
backinput;
end;
internal procedure reportoverflow(string s; integer n)
# for fatal errors when a TEX table is undersized;
begin pausing_on_errors←false;
error("TEX capacity exceeded, sorry ["&s&"="&cvs(n)&"]");
quit;
end;
internaldef overflow(s)=⊂reportoverflow("s",s)⊃ # specifies inadequate table size;
internal procedure memoverflow; overflow(memsize);
internal procedure confusion # TEX consistency check failure;
begin pausing_on_errors←false;
error("This can't happen");
DEBUGONLY bail;
quit;
end;
internal procedure mustquit; confusion;
comment Dynamic memory allocation: links, memsize, varsize, mem, memreal;
comment TEX does nearly all of its own memory allocation, so that it can
readily be transported into environments which do not have automatic
facilities for strings, garbage collection, etc. The dynamic storage
requirements of TEX are handled by providing a large integer array "mem"
in which consecutive blocks of words are used as nodes by the TEX routines.
Pointer variables are indices into this array. To use mem[p] as a real
variable instead of as an integer, we write "memreal(p)".
The mem array is divided once and for all into two regions which are allocated
separately. The first varsize locations are used for storing variable-length
records consisting of two or more words. This region is maintained using an
algorithm similar to the one described in exercise 2.5-19 of ACP. However,
no size field appears in the allocated nodes: the program is responsible for
knowing the relevant size when the node is freed. Also, the sign in the first
word of each node is used as a boundary tag by the allocation routines, so
ALL DATA STRUCTURES MUST BE DESIGNED TO ENSURE THAT THE FIRST WORD OF
TWO-OR-MORE-WORD NODES IS NONNEGATIVE. The remaining region of mem is allocated
in single words using a conventional AVAIL stack.
;
internaldef links = 14 # number of bits per pointer;
internaldef memsize=8000 # size of dynamic list memory, must be ≤ 2↑links;
internaldef varsize=2500 # size of variable node memory, must be << memsize;
preload_with 0 # the following array will be initialized upon loading;
internal integer array mem[0:memsize-1] # dynamic list memory;
internaldef memreal(p)=⊂memory[location(mem[p]),real]⊃ # mem[p] as type real;
DEBUGONLY internal integer dynused,varused # how much memory is in use;
comment Partial field macros: field,ufield,link,info,setfield...setinfo;
comment The following macros are for accessing and modifying partial fields
of packed words. If f is a field name, then fs denotes its size in bits
and fd denotes its displacement from the right of the word. These sizes and
displacements are defined at compile time--e.g.,"links" for size of link fields.
In the following definitions, x denotes the word being modified and y denotes
a new value to be inserted into the specified field (it must not be too
large for the field). The definitions look inefficient, but they take
advantage of the fact that SAIL does a lot of local optimization;
internaldef fs(f) = ⊂f⊃&"s" # field size of f, in bits;
internaldef fd(f) = ⊂f⊃&"d" # field displacement of f, in bits;
internaldef field(f,x) = ⊂ifc fd(f)=0 thenc ((x) land (2↑fs(f)-1))
elsec ifc fs(f)+fd(f)≥bitsperwd thenc ((x) lsh -fd(f))
elsec (((x) lsh -fd(f)) land (2↑fs(f)-1)) endc endc⊃ # field f of x;
internaldef setfield(f,x,y) = ⊂ifc fd(f)=0 thenc x←(x land(-2↑fs(f)))+(y)
elsec ifc fs(f)+fd(f)≥bitsperwd thenc
x←((x lsh(bitsperwd-fd(f)))+(y))rot fd(f)
elsec x←(((x rot -fd(f))land(-2↑fs(f)))+(y))rot fd(f) endc endc⊃
# sets field f of x equal to y, 0 ≤ y < 2↑fs(f);
comment Sometimes an unshifted field is desired. For this purpose, we use
ufield instead of field, and deal with values times 2↑fd;
internaldef ufield(f,x) = ⊂((x) land((1 lsh(fs(f)+fd(f)))-2↑fd(f)))⊃
# unshifted field f of x;
internaldef setufield(f,x,y) = ⊂x←(x land lnot((1 lsh(fs(f)+fd(f)))-2↑fd(f)))+(y)⊃
# field f of x set to unshifted value y;
comment The special case of a pointer field at the right of a word is
most common, so there are special conventions for it. When p is a pointer,
we write link(p) for the pointer field of mem[p] and info(p) for the
(shifted) remaining fields of the word;
internaldef linkd = 0 # displacement of link field;
internaldef link(p) = ⊂field(link,mem[p])⊃ # link field of mem[p];
internaldef setlink(p,y) = ⊂setfield(link,mem[p],y)⊃ # sets link(p)←y;
internaldef infod = links, infos = bitsperwd-infod # definition of info field;
internaldef info(p) = ⊂field(info,mem[p])⊃ # info field of mem[p];
internaldef setinfo(p,y) = ⊂setfield(info,mem[p],y)⊃ # sets info(p)←y;
DEBUGONLY integer procedure lk(integer x);
DEBUGONLY return(x land(2↑links-1)) # link field of packed word;
DEBUGONLY integer procedure fo(integer x);
DEBUGONLY return(x lsh -infod) # info field of packed word;
comment Memory allocation procedures: getavail, freeavail, getnode, freenode;
comment getavail(p) makes p point to a new one-word node,
freeavail(p) returns it to storage.
p←getnode(s) makes p point to a new s-word node and clears mem[p] to zero,
freenode(p,s) will return this node to storage.
;
internal integer avail # head of available space list for one-word nodes;
internaldef getavail(p) = ⊂begin if(p←avail)then avail←mem[avail]
else memoverflow: DEBUGONLY dynused←dynused+1: end⊃ # p ← new node;
internaldef freeavail(p) = ⊂begin mem[p]←avail: avail←p:
DEBUGONLY dynused←dynused-1: end⊃ # node p now available;
comment The available space list for variable-size nodes is a nonempty,
doubly-linked circular list, pointed to by the roving pointer "rover".
The second word of each entry contains the size (which is always ≥2), while
the first word contains the llink and rlink and a minus sign;
integer rover # pointer into double-avail list;
define nodesize(p) = ⊂mem[p+1]⊃;
define llinks = links, llinkd = infod # definition of llink field;
internal integer procedure getnode(integer size) # variable-size node allocation;
begin comment returns a pointer to a new node of the specified size,
which must be 2 or more. All words of the new node are set to zero;
integer p,q,s,t,u;
label ovfl, found;
comment The following tricky code does
llink(rlink(p))←llink(p), rlink(llink(p))←rlink(p);
define removenode(p)=
⊂begin if p=rover then
begin rover←link(p);
if p=rover then go to ovfl # list musn't become empty;
end;
u←((p lsh llinkd) + p) xor mem[p] # bits to change;
t←field(llink,mem[p]) # llink(p);
mem[t]←field(link,u) xor mem[t];
t←link(p) # rlink(p);
mem[t]←ufield(llink,u) xor mem[t];
end⊃;
p←rover;
do begin q←p+nodesize(p) # q points past the end of node(p);
while mem[q]<0 do
begin comment merge with the next node, if it is free too;
removenode(q); q←q+nodesize(q);
end;
if (s←q-p) ≥ size+2 then
begin q←q-size # allocate from top end;
nodesize(p)←q-p # remaining free area size;
rover ← p # let rover rove around;
go to found;
end;
if s = size then
begin removenode(p) # exact fit, now t = rlink(p);
rover ← t # let rover rove;
q ← p; go to found;
end;
nodesize(p)←s # reset the node size in case it grew;
p←link(p);
end until p=rover # repeat until whole list traversed;
ovfl: overflow(varsize) # no large enough space was found;
found: for p ← q thru q+size-1 do mem[p]←0 # clear out the node found;
DEBUGONLY varused←varused+size;
return(q) # deliver the goods;
end;
DEBUGONLY internal procedure checkmem(boolean printlocs) # checks links in mem;;
internal procedure freenode(integer p,size) # variable-size node liberation;
begin comment The node of length "size" starting at mem[p] is made available
to the variable-node storage pool, by inserting it into the double-avail
list just before where rover now points. We must have size ≥ 2;
integer q;
q←field(llink,mem[rover]) # llink(rover);
setlink(q,p); setfield(llink,mem[rover],p);
mem[p]←(q lsh llinkd)+rover+(1 lsh(bitsperwd-1)) # now p is linked into the circle;
DEBUGONLY varused←varused-size;
nodesize(p)←size;
end;
comment Memory, continued: dslist,delrclink,delgluelink,showmem,initmem;
internal procedure dslist(integer p) # makes list of 1-word nodes available;
begin comment The linked list of single-word nodes pointed to by p is freed;
integer q;
while p do
begin q←link(p); freeavail(p); p←q;
end;
end;
internaldef refct1 = 1 lsh infod # 1 in the information (reference count) field;
internal simple procedure delrclink(integer p) # remove ptr to list with ref ct;
begin comment info(p) is a reference count which is to be decreased by 1.
If the result is negative, the linked list of single-word nodes pointed to by p
is freed;
if(mem[p]←mem[p]-refct1)<0 then dslist(p);
end;
internal simple procedure delgluelink(integer p) # remove pointer to glue node;
begin comment info(p) is a reference count which is to be decreased by 1.
If the result is negative, node(p) (which has "gluespecsize" words) is freed;
if(mem[p]←mem[p]-refct1)<0 then freenode(p,gluespecsize);
comment In this case it's OK to let the first word of the node go negative;
end;
procedure showmem # checks and displays the free areas of mem when debugging;
begin comment This procedure prints a map of the free locations and checks
the format of the available space lists. All nodes should be returned to
the avail lists when TEX is done with them, and showmem can be used to
check if this has been done correctly;
boolean array free[0:memsize-1];
integer p,i; label printout;
p←avail;
while p do
begin if free[p] or mem[p]≥memsize or (mem[p]≠0 and mem[p]≤varsize) then
begin print(nextline,"avail list clobbered at ",p); done;
end;
free[p]←true;
p←mem[p];
end;
p←rover;
do begin
if p≥varsize or p≤0 or mem[p]≥0 or p+nodesize(p)>varsize or
nodesize(p)<2 or field(llink,mem[link(p)])≠p then
begin print(nextline,"double-avail list clobbered at ",p); done;
end;
for i←p thru p+nodesize(p)-1 do
begin if free[i] then
begin print(nextline,"doubly free location at ",i);
go to printout;
end;
free[i]←true;
end;
p←link(p);
end until p=rover;
printout: for i←0 thru memsize-1 do
begin if i mod 64 = 0 then print(nextline);
if free[i] then print("X") else print(".");
end;
end;
comment Some areas of mem are dedicated to fixed usage. For example, the
list heads "pagehead" and "pagecontrib" of the page builder are assigned
to fixed memory locations. (Since mem[pagecontrib] will never be
negative, we define pagecontrib=varsize, then the getfree procedure will
never try to combine the one-word memory with a variable-size free node.)
The special glue used in \hfill and \vfill is kept in a fixed place, as
are the heads of alignrecord lists. Only locations mem[firstmem] thru
mem[varsize-1] are actually allocatable for variable-size memory,
and mem[secondmem] thru mem[memsize-1] for one-word memory.
;
internaldef fillglue=0 # location of glue specification 0pt plus 10↑10 pt;
internaldef lowerfillglue=gluespecsize # loc of glue specification
0pt plus 10↑6pt minus 10↑6 pt;
internaldef zeroglue=lowerfillglue+gluespecsize # loc of glue specification 0pt;
internaldef firstmem=zeroglue+gluespecsize # location of
first usable mem word, must be >0.
internaldef waitinghead=varsize # head of list of inserts too big for current page;
internaldef contribhead=waitinghead+1 # head of contribution vlist for current page;
internaldef pagehead=pagecontrib+1 # head of vlist for current page;
internaldef temphead=pagehead+1 # temporary head of a miscellaneous list;
internaldef holdhead=temphead+1 # temporary head of another miscellaneous list;
internaldef alignhead=holdhead+1 # alignhead+j is head of jth alignrecordlist;
internaldef inserts=alignhead+alignsize # head of insert list returned by packager;
internaldef hsizemem=inserts+1 # location where current hsize is stored;
internaldef vsizemem=hsizemem+1 # location where current vsize is stored;
internaldef parindentmem=vsizemem+1 # location where current parindent is stored;
internaldef secondmem=parindentmem+1 # first usable mem word in 1-word area;
internal procedure initmem # initializes the memory system;
begin integer i;
for i←secondmem thru memsize-2 do mem[i+1]←i;
mem[secondmem]←0; avail←memsize-1 # now the avail stack is initialized;
mem[firstmem]←(firstmem lsh llinkd)+firstmem+(1 lsh(bitsperwd-1));
nodesize(firstmem)←varsize-firstmem # one node in the circle;
rover←firstmem # rover points to it, now the double-avail list is initialized;
for i←0 thru firstmem-1 do mem[i]←0;
for i←varsize thru secondmem-1 do mem[i]←0;
end;
comment Initializing the hash table and equivalents: identer,inithash;
procedure identer(string s; integer cmd,lnk);
begin comment This procedure forms the packed name corresponding to string s
and creates a hash table entry having idlev=1 and the specified cmd and
link. It is used only during the initialization of TEX, to store the reserved
control sequences into the hash table. Since the procedure changes global
variable curbuf, it must be used only before the "initin" procedure is called.
Since the procedure also indirectly accesses the savestack, it must be used
only after the "initsave" procedure is called;
inbuf←curbuf←s; controlseq # pretend s was in the input;
eqtb[hashentry]←ufield(idlen,eqtb[hashentry])+level1+(cmd lsh idcmdd)+lnk;
end;
procedure inithash # initialize hash and eqtb;
begin comment All predeclared control sequences are entered into the table here;
integer i;
for i←0 thru 127 do chartype(i)←otherchar;
for i←"A" thru "Z" do chartype(i)←letter;
for i←"a" thru "z" do chartype(i)←letter;
for i←'00,'12,'13,'175,'177 do chartype(i)←ignore # null,linefeed,vtab,alt,delete;
for i←'11,'40 do chartype(i)←spacer # tab and blankspace;
for i←'14,'15 do chartype(i)←carret # formfeed and carriagereturn;
identer("cr",carret,0);
identer("par",parend,0);
identer("x",xt,0);
memreal(hsizemem)←4.5*72.0 # default hsize is about 4.5 inches;
memreal(vsizemem)←7.0*72.0 # default vsize is about 7.0 inches;
memreal(maxdepthmem)←3.0 # default maxdepth is 3.0 points;
memreal(topbaselinemem)←10.0 # default topbaseline is 10.0 points;
comment The default value of parindent is 0.0;
identer("hsize",assignreal,hsizemem); pagemem[hsizemem]←4.5*72.0;
comment default hsize is about 4.5 inches;
identer("vsize",assignreal,vsizemem); pagemem[vsizemem]←7.0*72.0;
comment default vsize is about 7.0 inches;
identer("maxdepth",assignreal,maxdepthmem); pagemem[maxdepthmem]←3.0;
comment default maxdepth is 3.0 points;
identer("parindent",assignreal,parindentmem); pagemem[parindentmem]←0;
comment default parindent is zero;
identer("topbaseline",assignreal,topbaselinemem); pagemem[topbaselinemem]←10.0;
comment default topbaseline is 10.0 points;
identer("lineskip",assignglue,zeroglue); lineskiploc←hashentry;
identer("baselineskip",assignglue,zeroglue); baselineskiploc←hashentry;
identer("parskip",assignglue,zeroglue); parskiploc←hashentry;
identer("dispskip",assignglue,zeroglue); dispskiploc←hashentry;
identer("dispaskip",assignglue,zeroglue); dispaskiploc←hashentry;
identer("dispbskip",assignglue,zeroglue); dispbskiploc←hashentry;
identer("topskip",assignglue,zeroglue); topskiploc←hashentry;
identer("botskip",assignglue,zeroglue); botskiploc←hashentry;
identer("tabskip",assignglue,zeroglue); tabskiploc←hashentry;
identer(":",font,(1 lsh links)-1) # fontloc is hashsize+":";
identer("def",def,0);
identer("gdef",def,1);
identer("output",output,0);
identer("input",innput,0);
identer("end",stop,0);
identer("ddt",ddt,0);
identer("char",ascii,0);
identer("chcode",chcode,0);
identer("chpar",chcode,140);
identer("mathrm",fntfam,0);
identer("mathit",fntfam,1);
identer("mathsy",fntfam,2);
identer("mathex",fntfam,3);
identer("setcpage",setcpage,0);
identer("advcpage",advcpage,0);
identer("cpage",cpage,0);
identer("ifeven",ifeven,0);
identer("ifT",ifT,0);
identer("else",elsecode,0);
identer("box",box,1);
identer("page",box,0);
identer("vjust",box,1+vmode);
identer("hjust",box,1+hmode);
identer("moveleft",hmove,1);
identer("moveright",hmove,0);
identer("raise",vmove,1);
identer("lower",vmove,0);
identer("save",save,0);
identer("leaders",leaders,0);
identer("halign",halign,0);
identer("valign",valign,0);
identer("noalign",noalign,0);
identer("vskip",vskip,1);
identer("vfill",vskip,0);
identer("hskip",hskip,1);
identer("hfill",hskip,0);
identer("vrule",vrule,0);
identer("hrule",hrule,0);
identer("topinsert",topbotins,1);
identer("botinsert",topbotins,0);
identer("topmark",topbotmark,1);
identer("botmark",topbotmark,0);
identer("mark",mark,0);
identer("penalty",penlty,0);
identer("noindent",noindent,0);
identer("eject",eject,0);
identer("-",discr,"-");
identer("*",discr,'402);
identer("accent",newaccent,0);
identer("eqno",eqno,0);
identer(" ",exspace,userspace);
identer('11&null,exspace,userspace) # \<tab> is like \<space>;
identer('12&null,exspace,userspace) # \<lf> is like \<space>;
identer('13&null,exspace,userspace) # \<vt> is like \<space>;
identer('14&null,exspace,userspace) # \<ff> is like \<space>;
identer('15&null,exspace,userspace) # \<cr> is like \<space>;
identer("left",leftright,leftnoad);
identer("right",leftright,rightnoad);
identer("mathop",mathinput,opnoad);
identer("mathbin",mathinput,binnoad);
identer("mathrel",mathinput,relnoad);
identer("mathopen",mathinput,opennoad);
identer("mathclose",mathinput,closenoad);
identer("mathpunct",mathinput,punctnoad);
identer("sqrt",mathinput,sqrtnoad);
identer("overline",mathinput,overnoad);
identer("underline",mathinput,undernoad);
identer("limitswitch",limsw,0);
identer("above",above,0);
identer("atop",above,1);
identer("over",above,2);
identer("comb",above,3);
identer(",",mathstyle,thinspace);
identer(";",mathstyle,thickspace);
identer("≥",mathstyle,thspace);
identer("≤",mathstyle,negthspace);
identer("<",mathstyle,negopspace);
identer("!",mathstyle,negthinspace);
identer("?",mathstyle,negthickspace);
identer("dispstyle",mathstyle,dispstyle);
identer("textstyle",mathstyle,textstyle);
identer("scriptstyle",mathstyle,scriptstyle);
identer("scriptscriptstyle",mathstyle,scriptscriptstyle);
identer("/",italcorr,0);
identer("vcenter",vcenter,0);
identer("hangindent",hangindent,0);
comment The following codes refer to TEX's special non-ascii fonts;
identer("Gamma",mathonly,'00) # u.c. gamma;
identer("Delta",mathonly,'01) # u.c. delta;
identer("Theta",mathonly,'02) # u.c. theta;
identer("Lambda",mathonly,'03) # u.c. lambda;
identer("Xi",mathonly,'04) # u.c. xi;
identer("Pi",mathonly,'05) # u.c. pi;
identer("Sigma",mathonly,'06) # u.c. sigma;
identer("Upsilon",mathonly,'07) # u.c. upsilon;
identer("Phi",mathonly,'10) # u.c. phi;
identer("Psi",mathonly,'11) # u.c. psi;
identer("Omega",mathonly,'12) # u.c. omega;
identer("i",nonmathletter,'13) # dotless i;
identer("j",nonmathletter,'14) # dotless j;
identer("`",accent,'15) # grave accent;
identer("'",accent,'16) # acute accent;
identer("A",accent,'17) # circumflex (hat) accent;
identer("v",accent,'20) # inverted circumflex accent (Slavic);
identer("u",accent,'21) # breve;
identer("=",accent,'22) # macron (bar) accent;
identer("""",accent,'23) # umlaut or dieresis;
identer("H",accent,'24) # long Hungarian umlaut;
identer(">",accent,'25) # vector accent;
identer("s",accent,'26) # tilde;
identer("a",accent,'27) # small circle accent (Scandinavian);
identer("deg",mathonly,'27) # degree symbol, uses small circle accent by itself;
identer("ae",nonmathletter,'30) # Latin or Scandinavian ligature ae;
identer("l",nonmathletter,'31) # l with slash (Polish);
identer("ia",nonmathletter,'32) # ligature ia with inverted breve (Slavic);
identer("oe",nonmathletter,'33) # French ligature oe;
identer("AE",nonmathletter,'34) # Latin or Scandinavian ligature AE;
identer("L",nonmathletter,'35) # L with slash (Polish);
identer("IA",nonmathletter,'36) # ligature IA with inverted breve (Slavic);
identer("OE",nonmathletter,'37) # French ligature OE;
identer("o",nonmathletter,'40) # o with slash (Scandinavian);
identer("c",nonmathletter,'43) # c with cedilla (French);
identer("C",nonmathletter,'44) # C with cedilla (French);
identer("O",nonmathletter,'100) # O with slash (Scandinavian);
identer("Gammait",mathonly,'200) # u.c. italic gamma;
identer("Deltait",mathonly,'201) # u.c. italic delta;
identer("Thetait",mathonly,'202) # u.c. italic theta;
identer("Lambdait",mathonly,'203) # u.c. italic lambda;
identer("Xiit",mathonly,'204) # u.c. italic xi;
identer("Piit",mathonly,'205) # u.c. italic pi;
identer("Sigmait",mathonly,'206) # u.c. italic sigma;
identer("Upsilonit",mathonly,'207) # u.c. italic upsilon;
identer("Phiit",mathonly,'210) # u.c. italic phi;
identer("Psiit",mathonly,'211) # u.c. italic psi;
identer("Omegait",mathonly,'212) # u.c. italic omega;
identer("alpha",mathonly,'213) # l.c. alpha;
identer("beta",mathonly,'214) # l.c. beta;
identer("gamma",mathonly,'215) # l.c. gamma;
identer("delta",mathonly,'216) # l.c. delta;
identer("epsilon",mathonly,'217) # l.c. epsilon;
identer("zeta",mathonly,'220) # l.c. zeta;
identer("eta",mathonly,'221) # l.c. eta;
identer("theta",mathonly,'222) # l.c. theta;
identer("iota",mathonly,'223) # l.c. iota;
identer("kappa",mathonly,'224) # l.c. kappa;
identer("lambda",mathonly,'225) # l.c. lambda;
identer("mu",mathonly,'226) # l.c. mu;
identer("nu",mathonly,'227) # l.c. nu;
identer("xi",mathonly,'230) # l.c. xi;
identer("pi",mathonly,'231) # l.c. pi;
identer("rho",mathonly,'232) # l.c. rho;
identer("sigma",mathonly,'233) # l.c. sigma;
identer("tau",mathonly,'234) # l.c. tau;
identer("upsilon",mathonly,'235) # l.c. upsilon;
identer("phi",mathonly,'236) # l.c. phi;
identer("chi",mathonly,'237) # l.c. chi;
identer("iit",mathonly,'240) # dotless italic i;
identer("lscr",mathonly,'243) # l.c. script ell;
identer("wp",mathonly,'244) # Weierstrass p;
identer("partial",mathonly,'245) # partial derivative sign;
identer("jit",mathonly,'300) # dotless italic j;
identer("psi",mathonly,'373) # l.c. psi;
identer("omega",mathonly,'374) # l.c. omega;
identer("varphi",mathonly,'375) # variant l.c. phi (not pointed at top);
identer("vartheta",mathonly,'376) # variant l.c. theta (not closed at left);
identer("varomega",mathonly,'377) # variant l.c. omega (closed with bar at top);
identer("cdot",mathonly,bin('401)) # centered dot;
identer("times",mathonly,bin('402)) # cross product;
identer("ast",mathonly,bin('403)) # asterisk resting on baseline;
identer("rslash",mathonly,bin('404)) # reverse slash (\);
identer("circ",mathonly,bin('405)) # small circle operator;
identer("pm",mathonly,bin('406)) # plus-or-minus;
identer("mp",mathonly,bin('407)) # minus-or-plus;
identer("oplus",mathonly,bin('410)) # circle plus;
identer("ominus",mathonly,bin('411)) # circle minus;
identer("otimes",mathonly,bin('412)) # circle times (⊗);
identer("odiv",mathonly,bin('413)) # circle divide;
identer("odot",mathonly,bin('414)) # circle dot;
identer("div",mathonly,bin('415)) # elementary division (-:-);
identer("interc",mathonly,bin('416)) # intercalation product;
identer("perp",mathonly,rel('420)) # perpendicular (_|_);
identer("subset",mathonly,rel('422)) # ⊂_;
identer("supset",mathonly,rel('423)) # ⊃_;
identer("preceq",mathonly,rel('426)) # precedes or equals;
identer("succeq",mathonly,rel('427)) # succeeds or equals;
identer("approx",mathonly,rel('431)) # approximate equality;
identer("doteq",mathonly,rel('435)) # dot over equals;
identer("prec",mathonly,rel('436)) # precedes (curly version of <);
identer("succ",mathonly,rel('437)) # succeeds (curly version of >);
identer("up",mathonly,rel('442)) # ↑;
identer("down",mathonly,rel('443)) # ↓;
identer("lsls",mathonly,rel('445)) # <<;
identer("grgr",mathonly,rel('446)) # >>;
identer("simeq",mathonly,rel('447)) # ~-;
identer("←",mathonly,rel('450)) # <=;
identer("→",mathonly,rel('451)) # =>;
identer("↑",mathonly,rel('452)) # ∧||;
identer("↓",mathonly,rel('453)) # ∨||;
identer("↔",mathonly,rel('454)) # <=>;
identer("lsh",mathonly,bin('455)) # left shift symbol;
identer("rsh",mathonly,bin('456)) # right shift symbol;
identer("mapsto",mathonly,rel('457)) # |→;
identer("prime",mathonly,'460) # prime (intended to appear in script size only);
identer("in",mathonly,rel('462)) # ε meaning set element;
identer("space",mathonly,'463) # MIX space symbol;
identer("emptyset",mathonly,'464) # /0;
identer("angle",mathonly,'466) # /_;
identer("notin",mathonly,rel('467)) # /ε;
identer("aleph",mathonly,'473) # u.c. aleph;
identer("real",mathonly,'474) # u.c. Fraktur R;
identer("imag",mathonly,'475) # u.c. Fraktur I;
identer("not",mathonly,rel('500)) # zero-width character negates a relation symbol;
identer("Ascr",mathonly,'501) # u.c. script A;
identer("Bscr",mathonly,'502) # u.c. script B;
identer("Cscr",mathonly,'503) # u.c. script C;
identer("Dscr",mathonly,'504) # u.c. script D;
identer("Escr",mathonly,'505) # u.c. script E;
identer("Fscr",mathonly,'506) # u.c. script F;
identer("Gscr",mathonly,'507) # u.c. script G;
identer("Hscr",mathonly,'510) # u.c. script H;
identer("Iscr",mathonly,'511) # u.c. script I;
identer("Jscr",mathonly,'512) # u.c. script J;
identer("Kscr",mathonly,'513) # u.c. script K;
identer("Lscr",mathonly,'514) # u.c. script L;
identer("Mscr",mathonly,'515) # u.c. script M;
identer("Nscr",mathonly,'516) # u.c. script N;
identer("Oscr",mathonly,'517) # u.c. script O;
identer("Pscr",mathonly,'520) # u.c. script P;
identer("Qscr",mathonly,'521) # u.c. script Q;
identer("Rscr",mathonly,'522) # u.c. script R;
identer("Sscr",mathonly,'523) # u.c. script S;
identer("Tscr",mathonly,'524) # u.c. script T;
identer("Uscr",mathonly,'525) # u.c. script U;
identer("Vscr",mathonly,'526) # u.c. script V;
identer("Wscr",mathonly,'527) # u.c. script W;
identer("Xscr",mathonly,'530) # u.c. script X;
identer("Yscr",mathonly,'531) # u.c. script Y;
identer("Zscr",mathonly,'532) # u.c. script Z;
identer("uplus",mathonly,bin('535)) # multiset union +∪;
identer("vdash",mathonly,opn('540)) # |- (left turnstile);
identer("dashv",mathonly,cls('541)) # -| (right turnstile);
identer("lfloor",mathonly,opn('542)) # left floor bracket;
identer("rfloor",mathonly,cls('543)) # right floor bracket;
identer("lceil",mathonly,opn('544)) # left ceiling bracket;
identer("rceil",mathonly,cls('545)) # right ceiling bracket;
identer("{",mathonly,opn('546)) # left brace;
identer("}",mathonly,cls('547)) # right brace;
identer("langle",mathonly,opn('550)) # left angle bracket;
identer("rangle",mathonly,cls('551)) # right angle bracket;
identer("leftv",mathonly,opn('552)) # | treated as left bracket;
identer("rightv",mathonly,cls('552)) # | treated as right bracket;
identer("relv",mathonly,rel('552)) # | treated as relation (divides, or set def'n);
identer("|",mathonly,'553) # ||;
identer("leftvv",mathonly,opn('553)) # || treated as left bracket;
identer("rightvv",mathonly,cls('553)) # || treated as right bracket;
identer("relvv",mathonly,rel('553)) # || treated as relation (disjointness);
identer("surd",mathonly,'560) # radical (square root) sign;
identer("#",mathonly,'561) # sharp sign (hash mark or American pound);
identer("nabla",mathonly,'562) # inverted u.c. delta;
identer("smallint",mathonly,op('563)) # small integral sign;
identer("ss",mathonly,'570) # section symbol;
identer("dag",mathonly,'571) # dagger;
identer("ddag",mathonly,'572) # double dagger;
identer("P",mathonly,'573) # paragraph symbol;
identer("@",mathonly,'574) # at sign;
identer("copyright",mathonly,'575) # c in circle;
identer("sterling",mathonly,'576) # British pound sign;
identer("$",mathonly,'577) # dollar sign;
identer("oint",mathonly,op('710)) # large contour integral sign;
identer("odotprod",mathonly,op('712)) # large circle-dot sign;
identer("osum",mathonly,op('714)) # large circle-plus sign;
identer("oprod",mathonly,op('716)) # large circle-times sign;
identer("sum",mathonly,op('720)) # large Sigma sign for summation;
identer("prod",mathonly,op('721)) # large Pi sign for product;
identer("int",mathonly,op('722)) # large integral sign;
identer("union",mathonly,op('723)) # large set union sign;
identer("inter",mathonly,op('724)) # large set intersection sign;
identer("munion",mathonly,op('725)) # large multiset union sign (U with +);
identer("meet",mathonly,op('726)) # large logical or (lattice meet) sign;
identer("join",mathonly,op('727)) # large logical and (lattice join) sign;
comment Now set the standard parameter values in the upper part of eqtb;
mathfonttable(0)←mathfonttable(1)←mathfonttable(2)←mathfonttable(3)←-1;
tracing←0 # trace control;
jpar←2 # justification control;
hpen←25 # hyphenation penalty;
penpen←1000 # penultimate hyphenation penalty (squared);
wpen←80 # widow line penalty;
bpen←50 # page break after hyphenated line penalty;
mbpen←50 # penalty for line break after binary operator in math formula;
mrpen←25 # penalty for line break after relation in math formula;
begin comment Now the hash and eqtb arrays are initialized, report their fullness;
integer n;
n←0;for i←0 thru hashsize-1 do if hash[i] then n←n+1;
print(nextline,"Hash table of size ",hashsize," preloaded with ",n,
" control sequences.");
n←0;for i←0 thru 127 do if eqtb[hashsize+i] then n←n+1;
print(nextline,"Furthermore ",n," single-character control sequences are",
" predefined.");
end;
end;
comment Initializing the exception table;
procedure xent(string s) # enter an exception s;
begin integer n,m,c,w,t,i,j,h; string ss;
ss←s; n←0; w←0; m←0;
while c←lop(s) do
if c="-" then w←w lor 1 else
if c="*" then m←m+1 else
begin n←n+1; w←w lsh 1;
mem[n] ← c land '37;
end;
w←w rot(1-n);
j←7 min n;
while m do begin w←w+(mem[j+m]lsh(5*(m-1))); m←m-1 end;
t←mem[1];
for i←2 thru j do t←(t lsh 5)+mem[i];
h←t mod excepsize;
while t do
begin while exceptable[h]>t do h←h-1;
if h=0 then h←excepsize-1
else if exceptable[h]=t then
begin print(nextline,"Whoops: double entry ",ss);
return;
end
else begin j←exceptable[h]; c←excephyph[h];
exceptable[h]←t; excephyph[h]←w;
t←j; w←c;
end;
end;
end;
preload_with
"con-trol-lable","un-con-trollable",
"eq-uable","in-sa-tiable","ne-go-tiable","so-ciable","turn-table","un-so-ciable",
"de-pend-ent","in-de-pend-ent",
"any-thing","bal-ding","dar-ling","dump-ling","err-ing","eve-ning","every-thing",
"far-thing","found-ling","ink-ling","main-spring","nest-ling","off-spring",
"play-thing","sap-ling","shoe-string","sib-ling","some-thing","star-ling",
"ster-ling","un-err-ing","up-swing","weak-ling","year-ling",
"civ-i-lize","crys-tal-lize","im-mo-bi-lize","me-ta-bo-lize","mo-bi-lize",
"mo-nop-o-lize","sta-bi-li*ze","tan-ta-lize","un-civ-i-lized",
"pal-ate",
"in-clem-ent",
"bar-on-ess","li-on-ess",
"eu-logy","ped-a-gogy",
"lus-cious",
"at-mos-phere",
"met-al","non-metal","pet-al","postal","rent-al",
"cat-ion",
"com-bat-ive",
"stat-ure",
"beck-on","bes-tial",
"com-a-tose","come-back","co-me-dian","comp-troller",
"cone-flower","co-nun-drum",
"equipped",
"handle-bar",
"inch-worm","ink-blot","inn-keeper",
"in-te-rior",
"min-is-ter","min-is-try",
"none-the-less",
"qua-drille",
"som-er-sault",
"su-pe-rior",
"una-nim-ity","unan-i-mous","unc-tuous",
"debt-or",
"ac-knowl-edge",
"de-duct-i*ble","ex-act-i-tude","in-ex-act-i-tude",
"pre-dict-*able","re-spect-*able","un-pre-dict-able","vict-ual",
"nee-dle-work","idler",
"buff-er","off-beat","off-hand","off-print","off-shoot","off-shore",
"stiff-en",
"left-ist","left-over","lift-off",
"soft-hearted",
"egg-nog","egg-head",
"cognac","for-eign-er","vi-gnette",
"hogs-head",
"child-ish","eld-est","hold-out","hold-over","hold-up",
"self-ish",
"bull-ish","crest-fallen","dis-till-*ery","fall-out","lull-aby","roll-away",
"sell-out","wall-eye",
"psalm-ist",
"else-where","false-hood",
"con-sult-ant","volt-age",
"re-solv-able","re-volv-er","solv-able","un-solv-able",
"beach-comb-er","bomb-er","climb-er","plumb-er",
"damp-en","damp-est",
"clinch-er","launch-er","lunch-eon","ranch-er","trench-ant",
"an-nouncer","bouncer","fencer","hence-forth","mince-meat","si-lencer",
"bind-ery","bound-ary","com-mend-*a-*t*ory","de-pend-able","ex-pend-able",
"fiend-ish","land-owner","out-land-ish","round-about","send-off","stand-out",
"change-over","hang-out","hang-over","ha-rangue","me-ringue","orange-ade",
"tongue","venge-ance",
"sense-less",
"ac-count-ant","ant-acid","ant-eater","count-ess","rep-re-sentative",
"ant-hill","pent-house","per-cent-*age",
"ac-cept-able","ac-cept-or","adapt-able","adapt-er","crypt-analysis",
"in-ter-ru*p*t-*i*ble",
"an-tiq-uity","in-eq-uity","in-iq-uity","liq-uefy","liq-uid",
"liq-ui-date","liq-uor","pre-req-ui-site","req-ui-sition",
"ubiq-ui-tous",
"ab-sorb-ent","carb-on","herbal","im-per-turb-able",
"arch-ery","arch-angel","re-search-ers","un-search-able",
"ac-cord-ance","board-er","chordal","hard-en","hard-est","haz-ard-ous",
"jeop-ard-ize","re-cord-er","stand-ard-ize","stew-ard-ess","yard-age",
"surf-er",
"morgue",
"curl-i-que",
"af-firm-a-*t*i*ve","con-form-*ity","de-form-ity","in-form-a*nt","non-con-form-ist",
"cav-ern-ous","dis-cern-ible","mod-ern-ize","turn-about","turn-over",
"un-gov-ern-able","west-ern-ize",
"harp-ist","sharp-en",
"torque",
"coars-en","ir-re-vers-ible","nurse-maid","nurs-ery","purser","re-hears-al",
"re-vers-ible","wors-en",
"art-ist","con-vert-ible","court-yard","fore-short-en","heart-ache","heart-ily",
"short-en",
"apart-heid","court-house","earth-en-ware","north-east","north-ern","port-hole",
"nerv-ous","ob-serv-a*ble","ob-serv-er","pre-serv-*a-*t*i*ve","serv-er",
"serv-ice-able",
"pre-school",
"con-de-scend","cre-scendo","de-cre-scendo","de-scend-ent","de-scent",
"pleb-i-scite","re-scind","sea-scape",
"askance","snake-skin","whisk-er",
"cole-slaw",
"rattle-snake",
"class-room","class-ify","cross-over","dis-miss-al","ex-press-ible",
"im-pass-able","less-en","pass-able","toss-up","un-class-i-fied",
"ar-mi-stice","astig-ma-tism","astir","aston-ish-ment","blast-off","by-stand-er",
"candle-stick","cast-away","cast-off","con-test-ant","co-star",
"de-test-able","di-gest-ible","east-ern","ex-ist-ence","fore-stall",
"in-con-test-able","in-di-ges*t-*i*ble","in-ex-haust-ible","life-style",
"lime-stone","live-stock","mile-stone","non-ex-ist-ent","per-sist-ent",
"pho-to-stat","re-start-ed","re-state-ment","re-store","shy-ster",
"side-step","smoke-stack","sug-gest-*i*ble","thermo-stat","waste-bas-ket",
"waste-land",
"mast-head","post-hu-mous","priest-hood",
"side-swipe",
"watt-meter",
"be-tween",
"kib-itzer",
"buzz-er",
"al-go-rithm","bib-li-og-raphy","bi-no-mial","cen-ter","com-put-a-*bil-ity",
"dec-la-ra-tion","de-gree","es-tab-lish","hap-hazard","neg-li-gible","pe-ri-odic",
"poly-no-mial","pre-vious","pro-ce-dure","prob-able","prob-a-bil-ity",
"pub-li-ca-tion","pub-lish","re-place-ment","when-ever",
"gen-er-ator",
""; string array exceptions[0:excepsize-1];
procedure initex;
begin integer i; string s;
arrclr(exceptable); arrclr(excephyph);
i←0;
while s←exceptions[i] do
begin xent(s); i←i+1;
end;
print(nextline,"Exception table contains ",i," entries in ordered hash table",
" of size ",excepsize,".");
end;
comment Initializing the suffix table;
procedure initsuf;
begin
define opcodes=9,opcoded=27,truexs=9,truexd=18,falsexs=9,falsexd=9,oprands=9,
oprandd=0 # fields in interpreted instructions;
define scan=0,double=1,table=2,check=3,success=4,fail=5,repeat=6,again=7,
mark=8,efail=9 # numeric equivalents of symbolic opcodes;
define s(n,a,b,c,d)=⊂suffix[n]←(a lsh opcoded)+(b lsh oprandd)+
(c lsh truexd)+(d lsh falsexd)⊃;
define t(c)=⊂(flag lsh -("c" land '37))⊃;
suffix[0]←flag+t(a)+t(e)+t(i)+t(o)+t(u)+t(y);
s(1,fail,0,0,0) # a;
s(2,fail,0,0,0) # b;
s(3,scan,"i",34,1) # c;
s(4,again,0,1,0) # d;
s(5,mark,0,38,0) # e;
s(6,fail,0,0,0) # f;
s(7,scan,"n",60,1) # g;
s(8,fail,0,0,0) # h;
s(9,fail,0,0,0) # i;
s(10,fail,0,0,0) # j;
s(11,fail,0,0,0) # k;
s(12,scan,"a",71,72) # l;
s(13,fail,0,0,0) # m;
s(14,scan,"o",77,1) # n;
s(15,fail,0,0,0) # o;
s(16,fail,0,0,0) # p;
s(17,fail,0,0,0) # q;
s(18,scan,"e",81,1) # r;
s(19,mark,0,85,0) # s;
s(20,scan,"n",94,1) # t;
s(21,fail,0,0,0) # u;
s(22,fail,0,0,0) # v;
s(23,fail,0,0,0) # w;
s(24,fail,0,0,0) # x;
s(25,scan,"l",31,98) # y;
s(26,efail,0,0,0) # z;
s(27,success,0,0,0);
s(28,success,1,0,0);
s(29,success,2,0,0);
s(30,success,3,0,0);
s(31,repeat,0,0,0);
s(32,repeat,1,0,0);
s(33,repeat,2,0,0);
s(34,scan,"p",35,26) # e/ic;
s(35,scan,"o",36,26) # pe/pic;
s(36,scan,"c",37,26) # ope/opic;
s(37,scan,"s",27,26) # cope/copic;
s(38,scan,"l",39,40) # e;
s(39,scan,"b",41,26) # le;
s(40,scan,"t",42,43) # e;
s(41,scan,"a",44,26) # ble;
s(42,scan,"a",45,26) # te;
s(43,scan,"z",46,47) # e;
s(44,scan,"t",48,49) # able;
s(45,table,50,108,26) # ate;
s(46,scan,"i",51,26) # ze;
s(47,scan,"v",52,53) # e;
s(48,table,54,33,26) # table;
s(49,table,107,32,26) # able;
suffix[50]←t(c)+t(l);
s(51,scan,"l",32,26) # ize;
s(52,scan,"i",55,26) # ve;
s(53,scan,"r",56,34) # e;
suffix[54]←t(n)+t(r);
s(55,scan,"t",27,26) # ive/ure;
s(56,scan,"u",55,57) # re;
s(57,scan,"e",58,26) # re;
s(58,scan,"h",59,26) # ere;
s(59,scan,"p",37,26) # here;
s(60,scan,"i",61,1) # ng;
s(61,check,0,62,1) # ing;
s(62,scan,"l",63,64) # ing;
s(63,table,65,27,66) # ling;
s(64,table,67,28,68) # ing;
suffix[65]←t(b)+t(c)+t(d)+t(f)+t(g)+t(p)+t(t)+t(z);
s(66,scan,"k",69,28) # ling;
suffix[67]←t(f)+t(s)+t(z);
s(68,table,0,28,70) # ing;
s(69,scan,"c",29,27) # kling;
s(70,double,0,27,27) # ing;
s(71,scan,"i",73,74) # al;
s(72,scan,"u",75,1) # l;
s(73,scan,"t",27,76) # al/ial;
s(74,scan,"n",14,73) # al;
s(75,scan,"f",31,1) # ul;
s(76,scan,"c",27,1) # al/ial/ient;
s(77,scan,"i",78,1) # on/onal;
s(78,table,79,80,1) # ion/ional;
suffix[79]←t(s)+t(t);
s(80,mark,4,27,0) # sion/sional/tion/tional;
s(81,scan,"h",82,1) # er/y;
s(82,scan,"p",83,1) # her/hy;
s(83,scan,"a",84,1) # pher/phy;
s(84,scan,"r",27,1) # apher/aphy;
s(85,scan,"u",86,87) # s;
s(86,scan,"o",88,4) # us;
s(87,scan,"s",89,4) # s;
s(88,scan,"i",90,4) # ous;
s(89,scan,"e",91,4) # ss;
s(90,scan,"c",92,4) # ious;
s(91,table,93,31,4) # ess;
s(92,scan,"s",27,27) # cious;
suffix[93]←t(l)+t(n);
s(94,scan,"e",95,1) # nt;
s(95,scan,"m",31,96) # ent;
s(96,scan,"d",27,97) # ent;
s(97,scan,"i",76,1) # ent;
s(98,scan,"g",99,100) # y;
s(99,scan,"o",27,1) # gy;
s(100,scan,"r",101,81) # y;
s(101,scan,"a",102,1) # ry;
s(102,scan,"n",103,1) # ary;
s(103,scan,"o",104,105) # nary;
s(104,scan,"i",106,28) # onary;
s(105,scan,"e",29,27) # nary;
s(106,repeat,3,0,0) # ionary;
suffix[107]←t(e)+t(h)+t(i)+t(k)+t(l)+t(o)+t(u)+t(v)+t(w)+t(x)+t(y);
s(108,table,0,28,26) # cate/late;
end;
comment Initializing the prefix table;
procedure initpref;
begin
define opcodes=9,opcoded=27,truexs=9,truexd=18,falsexs=9,falsexd=9,oprands=9,
oprandd=0 # fields in interpreted instructions;
define scan(n,c,t,f)=⊂prefix[n]←"c"+(t lsh truexd)+(f lsh falsexd)⊃;
define repeat(n,t)=⊂prefix[n]←(6 lsh opcoded)+t⊃;
define mark(n,t)=⊂prefix[n]←(8 lsh opcoded)+t⊃;
define table(n)=⊂prefix[n]←(2 lsh opcoded)⊃;
require "." message;
define fayl(n)=⊂prefix[n]←5 lsh opcoded⊃;
require "." message;
define vow(n)=⊂prefix[n]←4 lsh opcoded⊃;
define cons(n)=⊂prefix[n]←7 lsh opcoded⊃;
define t(c)=⊂(flag lsh -(("c" land '37)+opcodes))⊃;
define vs=1,cs=6,ts=7 # locations where there is a "vow","cons","table0" inst;
fayl(0) # in case mem[u+1] gets set to zero by the suffix routine;
vow(1) # a;
scan(2,e,34,cs) # b;
scan(3,o,36,cs) # c;
scan(4,i,38,cs) # d;
scan(5,q,41,44) # e;
cons(6) # f;
table(7) # g;
scan(8,a,45,47) # h;
scan(9,m,27,55) # i;
cons(10) # j;
cons(11) # k;
scan(12,e,61,cs) # l;
scan(13,a,63,70) # m;
scan(14,o,76,cs) # n;
scan(15,u,77,78) # o;
scan(16,s,81,cs) # p;
scan(17,u,85,cs) # q;
cons(18) # r;
scan(19,e,87,89) # s;
scan(20,h,97,99) # t;
scan(21,n,106,vs) # u;
cons(22) # v;
cons(23) # w;
cons(24) # x;
vow(25) # y;
cons(26) # z;
repeat(27,0);
repeat(28,1);
repeat(29,2);
mark(30,0);
mark(31,1);
mark(32,2);
mark(33,3);
table(34)+t(c)+t(h)+t(s)+t(w) # be;
scan(35,i,vs,27) # un;
scan(36,m,30,37) # co;
scan(37,n,30,vs) # co;
scan(38,s,39,vs) # di;
scan(39,h,ts,40) # dis;
scan(40,y,vs,27) # dis;
scan(41,u,42,cs) # eq;
scan(42,i,43,cs) # equ;
scan(43,v,30,30) # equi;
scan(44,x,30,vs) # e;
scan(45,n,46,vs) # ha;
scan(46,d,30,ts) # han;
scan(47,o,48,51) # h;
scan(48,r,49,vs) # ho;
scan(49,s,50,ts) # hor;
scan(50,e,30,ts) # hors;
scan(51,y,52,cs) # h;
scan(52,p,53,vs) # hy;
scan(53,e,54,ts) # hyp;
scan(54,r,33,vs) # hype;
scan(55,n,56,vs) # i;
scan(56,t,57,27) # in;
scan(57,e,58,59) # int;
scan(58,r,33,29) # inte;
scan(59,r,60,28) # int;
scan(60,o,33,29) # intr;
scan(61,x,62,vs) # le;
scan(62,i,31,ts) # lex/max/min;
scan(63,c,64,66) # ma;
scan(64,r,65,ts) # mac;
scan(65,o,32,ts) # macr;
scan(66,t,67,69) # ma;
scan(67,h,68,ts) # mat;
scan(68,e,31,ts) # math;
scan(69,x,62,vs) # ma;
scan(70,i,71,72) # m;
scan(71,n,62,vs) # mi;
scan(72,u,73,cs) # m;
scan(73,l,74,vs) # mu;
scan(74,t,75,ts) # mul;
scan(75,i,32,ts) # mult;
scan(76,n,27,vs) # no;
scan(77,t,30,vs) # ou;
scan(78,v,79,vs) # o;
scan(79,e,80,ts) # ov;
scan(80,r,27,vs) # ove;
scan(81,e,82,cs) # ps;
scan(82,u,83,vs) # pse;
scan(83,d,84,vs) # pseu;
scan(84,o,32,ts) # pseud;
scan(85,a,86,cs) # qu;
scan(86,d,30,vs) # qua;
scan(87,m,88,vs) # se;
scan(88,i,30,ts) # sem;
scan(89,o,90,92) # s;
scan(90,m,91,vs) # so;
scan(91,e,30,ts) # som/ther;
scan(92,u,93,cs) # s;
scan(93,b,30,94) # su;
scan(94,p,95,vs) # su;
scan(95,e,96,ts) # sup;
scan(96,r,33,vs) # supe;
scan(97,e,98,cs) # th;
scan(98,r,91,vs) # the;
scan(99,r,100,cs) # t;
scan(100,a,101,104) # tr;
scan(101,n,102,vs) # tra;
scan(102,s,103,ts) # tran;
table(103)+t(a)+t(f)+t(g)+t(l)+t(m) # trans;
scan(104,i,105,cs) # tr;
table(105)+t(a)+t(f)+t(u) # tri;
scan(106,d,107,35) # un;
scan(107,e,108,28) # und;
scan(108,r,33,29) # unde;
end;
comment Initializing the consonant-pair table;
procedure initb # sets btable;
begin
define hchars=3,hchard=0,weaks=3,weakd=3 # definition of btable fields;
define t(c)=⊂(flag lsh -(("c" land '37)-1))⊃;
define weak(n)=⊂(n lsh weakd)+btable[26+n]⊃;
define b(n)=⊂btable[n]←0⊃;
b(26) # weak(0) and z;
b(27)+t(t) # weak(1), for f and s;
b(28)+t(d) # weak(2), for l;
b(29)+t(p) # weak(3), for m;
b(30)+t(d)+t(g)+t(s)+t(t) # weak(4), for n;
b(31)+t(g)+t(m)+t(n)+t(t) # weak(5), for r;
b(2)+t(l)+t(r) # b;
b(3)+t(l)+t(r)+4 # c;
b(4)+t(g)+t(r) # d;
b(5)+t(l)+t(r) # ch;
b(6)+t(l)+t(r)+weak(1) # f;
b(7)+t(l)+t(r)+4 # g;
b(8) # h;
b(9)+t(t) # gh;
b(10) # j;
b(11)+t(n) # k;
b(12)+t(k)+t(q)+weak(2) # l;
b(13)+weak(3) # m;
b(14)+t(e)+t(k)+t(x)+weak(4) # n;
b(15)+t(r) # ph;
b(16)+t(l)+t(r)+1 # p;
b(17) # q;
b(18)+t(k)+weak(5) # r;
b(19)+t(p)+t(q)+weak(1)+4 # s;
b(20)+t(e)+t(r)+7 # t;
b(21) # sh;
b(22) # v;
b(23)+t(h)+t(l)+t(n)+t(r) # w;
b(24) # x;
b(25)+t(r) # th;
end;
comment Initializing the delimiter table;
procedure initd # sets delimtable;
begin arrclr(delimtable,-1);
comment Each nondelimiter gets the value -1,
while each delimiter gets the 18-bit delimiter code used by math routines;
delimtable["."] ← 0;
delimtable["("] ← '050600;
delimtable[")"] ← '051601;
delimtable["["] ← '133602;
delimtable["]"] ← '135603;
delimtable["<"] ← '550612;
delimtable[">"] ← '551613;
delimtable["|"] ← '552614;
delimtable["/"] ← '057616;
end;
comment The driver program;
integer chan;
initin;initsave;inithash;
initex;initsuf;initpref;initb;
initd;
open(chan←getchan,"DSK",'10,0,2,0,0,eof);
enter(chan,"TEXINI.TBL",eof);
wordout(chan,hashsize);
wordout(chan,eqtbsize);
wordout(chan,locsize);
wordout(chan,excepsize);
wordout(chan,sufsize);
wordout(chan,prefsize);
wordout(chan,btabsize);
wordout(chan,pagememsize);
arryout(chan,hash[0],hashsize);
arryout(chan,eqtb[0],eqtbsize);
arryout(chan,locs[0],locsize);
arryout(chan,exceptable[0],excepsize);
arryout(chan,excephyph[1],excepsize-1);
arryout(chan,suffix[0],sufsize);
arryout(chan,prefix[0],prefsize);
arryout(chan,btable[2],btabsize);
arryout(chan,pagemem[0],pagememsize);
arryout(chan,delimtable[0],128);
release(chan);
print(nextline,"TEX tables written on TEXINI.TBL.");
end_of_texpre:
end